Attribute VB_Name = "sap40b_zcs15"
Option Compare Database
Option Explicit

Private SAPApp As Object
Private SAPGUI As Object
Private SAPConnect As Object
Private SAPSession As Object
Private WScript As Object
Private SAPUserArea As Object

Private objExcel As Excel.Application
Private objBook As Workbook
Private objSheet As Worksheet

Private rstTemp As Recordset

Private Sub SAP_ZCS15()
'Dim SAPApp As Object
'Dim SAPGUI As Object
'Dim SAPConnect As Object
'Dim SAPSession As Object
'Dim WScript As Object
'Dim SAPUserArea As Object

Dim strMATNR As String

Dim SQL As String
'Dim rstTemp As Recordset

'Dim objExcel As Excel.Application
'Dim objBook As Workbook
'Dim objSheet As Worksheet

Dim intErr As Integer
Dim strErrType As String
Dim strErrText As String

   On Error GoTo SAP_ZCS15_Error
    
    intErr = 0 'DEFAULT ERROR
    
'    On Error Resume Next
'    Set SAPGUI = GetObject("SAPGUI")
'    On Error GoTo 0
'
'    If SAPGUI Is Nothing Then
'        MsgBox "Please start SAP logon."
'        Exit Sub
'    Else
'        On Error Resume Next
'        Set SAPApp = SAPGUI.GetScriptingEngine
'        On Error GoTo 0
'
'        If SAPApp Is Nothing Then
'            MsgBox "Scripting disable."
'            Exit Sub
'        Else
'    End If
        
    If SAPApp Is Nothing Then
        Set SAPGUI = GetObject("SAPGUI")
        Set SAPApp = SAPGUI.GetScriptingEngine
    End If
    If SAPConnect Is Nothing Then
       Set SAPConnect = SAPApp.Children(0)
    End If
    If SAPSession Is Nothing Then
       Set SAPSession = SAPConnect.Children(0)
    End If
    If Not WScript Is Nothing Then
       WScript.ConnectObject SAPSession, "on"
       WScript.ConnectObject SAPApp, "on"
    End If
    
    Call DB_DELETE_COMPLETED
    
    SQL = "SELECT tbl_MATNR.MATNR " & _
    "FROM tbl_MATNR " & _
    "GROUP BY tbl_MATNR.MATNR " & _
    "ORDER BY tbl_MATNR.MATNR;"
    Set rstTemp = CurrentDb.OpenRecordset(SQL)
    With SAPSession
        intErr = 1 'ZCS15 ERROR
        Do Until rstTemp.EOF: DoEvents
            strMATNR = rstTemp.Fields(0).Value
            
            'ZCS15_PART1
'            Call SAP_ZCS15_MATNR(SAPSession, strMATNR)
            Call SAP_ZCS15_MATNR(strMATNR)
            
            'ZCS15_PART2
            intErr = 2 'EXCEL ERROR
'            Call SAP_ZCS15_EXCEL(SAPSession, objExcel, objBook, objSheet, rstTemp)
            Call SAP_ZCS15_EXCEL
            
'            Call ImportOpenExcel(objSheet, rstTemp.Fields(0).Value)
'            Call EXCEL_IMPORT(objSheet, strMATNR)
            Call EXCEL_IMPORT(strMATNR)
            
'            .findById("wnd[0]/tbar[0]/btn[3]").press
            
            'CLOSES OUT EXCEL
            If Not objSheet Is Nothing Then Set objSheet = Nothing
            If Not objBook Is Nothing Then objBook.Close False: Set objBook = Nothing
            If Not objExcel Is Nothing Then objExcel.Quit: Set objExcel = Nothing
            
            rstTemp.MoveNext
        Loop
    End With
    

   On Error GoTo 0
   Exit Sub

'SAP_ZCS15_Resume:
'    rstTemp.MoveNext
'    strMATNR = rstTemp.Fields(0).Value
'    With SAPSession
'        .sendcommand ("/n") 'RETURNS TO INITIAL SCREEN
'        .sendcommand ("ZCS15") 'CALL CUSTOM WHERE-USED REPORT
'        .findById("wnd[0]/usr/ctxtP_MATNR").Text = strMATNR
'        .findById("wnd[0]/usr/ctxtP_WERKS").Text = "*"
'        .findById("wnd[0]/usr/ctxtP_POSTP").Text = "L"
'        .findById("wnd[0]/usr/ctxtP_STLAN").Text = "1"
'    End With
'    Resume Next
'
'SAP_ZCS15_EXCEL:
'    If Not objSheet Is Nothing Then Set objSheet = Nothing
'    If Not objBook Is Nothing Then objBook.Close False: Set objBook = Nothing
'    If Not objExcel Is Nothing Then objExcel.Quit: Set objExcel = Nothing

SAP_ZCS15_Error:

    If intErr = 1 Then
        strErrType = SAPSession.findById("wnd[0]/sbar").messageType
        strErrType = Trim(strErrType)
        strErrText = SAPSession.findById("wnd[0]/sbar").Text
        strErrText = Trim(strErrText)
        DoCmd.SetWarnings False
        SQL = "INSERT INTO [tbl_Error_Log] VALUES('" & strErrType & "','" & strErrText & "','" & strMATNR & "');"
        DoCmd.RunSQL SQL
        DoCmd.SetWarnings True
            
        rstTemp.MoveNext
        strMATNR = rstTemp.Fields(0).Value
'        Call SAP_ZCS15_MATNR(SAPSession, strMATNR)
        Call SAP_ZCS15_MATNR(strMATNR)
        Resume Next
    ElseIf intErr = 2 Then
        strErrType = SAPSession.findById("wnd[0]/sbar").messageType
        strErrType = Trim(strErrType)
        strErrText = SAPSession.findById("wnd[0]/sbar").Text
        strErrText = Trim(strErrText)
        DoCmd.SetWarnings False
        SQL = "INSERT INTO [tbl_Error_Log] VALUES('" & strErrType & "','" & strErrText & "','" & strMATNR & "');"
        DoCmd.RunSQL SQL
        DoCmd.SetWarnings True
            
        rstTemp.MoveNext
        strMATNR = rstTemp.Fields(0).Value
'        Call SAP_ZCS15_MATNR(SAPSession, strMATNR)
'        Call SAP_ZCS15_EXCEL(SAPSession, objExcel, objBook, objSheet, rstTemp)
        Call SAP_ZCS15_MATNR(strMATNR)
        Call SAP_ZCS15_EXCEL
        Resume Next
'        Debug.Print "EXCEL Error - " & strMATNR

'No records to download
'E
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SAP_ZCS15 of Module new_dev"
    End If
End Sub

Private Sub SAP_ZCS15_MATNR(ByVal strMATNR As String)
'Private Sub SAP_ZCS15_MATNR(ByRef Session As Object, ByVal strMATNR As String)
    With SAPSession
        .sendcommand ("/n") 'RETURNS TO INITIAL SCREEN
        .sendcommand ("ZCS15") 'CALL CUSTOM WHERE-USED REPORT
        .findById("wnd[0]/usr/ctxtP_MATNR").Text = strMATNR
        .findById("wnd[0]/usr/ctxtP_WERKS").Text = "*"
        .findById("wnd[0]/usr/ctxtP_POSTP").Text = "L"
        .findById("wnd[0]/usr/ctxtP_STLAN").Text = "1"
    End With
End Sub

Private Sub SAP_ZCS15_EXCEL()
'Private Sub SAP_ZCS15_EXCEL(ByRef refSession As Object, ByRef refExcel As Object, ByRef refBook As Object, ByRef refSheet As Object, ByRef refRST As Recordset)
Dim strErrType As String
Dim strErrText As String

    'CLOSES OUT EXCEL
   On Error GoTo SAP_ZCS15_EXCEL_Error

    If Not objSheet Is Nothing Then Set objSheet = Nothing
    If Not objBook Is Nothing Then objBook.Close False: Set objBook = Nothing
    If Not objExcel Is Nothing Then objExcel.Quit: Set objExcel = Nothing
    
    With SAPSession
        .findById("wnd[0]/tbar[1]/btn[8]").press 'EXECUTES REPORT
        .findById("wnd[0]/tbar[1]/btn[8]").press 'DOWNLOAD TO LOCAL FILE
        .findById("wnd[1]/usr/sub:SAPLSPO5:0101/radSPOPLI-SELFLAG[2,0]").Select 'EXCEL DISPLAY
        .findById("wnd[1]/tbar[0]/btn[0]").press 'EXECUTE
    End With
    
    Set objExcel = GetObject(, "Excel.Application")
    For Each objBook In objExcel.Workbooks
        If InStr(1, objBook.Name, "Book", vbTextCompare) > 0 Then
            Set objSheet = objBook.Worksheets("ULO")
            Exit For
        End If
    Next

   On Error GoTo 0
   Exit Sub

SAP_ZCS15_EXCEL_Error:
    
    strErrType = SAPSession.findById("wnd[0]/sbar").messageType
    strErrType = Trim(strErrType)
    strErrText = SAPSession.findById("wnd[0]/sbar").Text
    strErrText = Trim(strErrText)
    
    If StrComp(strErrText, "No records to download", vbTextCompare) = 0 Or _
    InStr(1, strErrText, "Has Cross Plant Status Cancelled", vbTextCompare) > 1 Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL "INSERT INTO [tbl_Error_Log] VALUES('" & strErrType & "','" & strErrText & "','" & rstTemp.Fields(0).Value & "');"
        DoCmd.SetWarnings True
        
        rstTemp.MoveNext
'        Call SAP_ZCS15_MATNR(refSession, refRST.Fields(0).Value)
'        Call SAP_ZCS15_EXCEL(refSession, refExcel, refBook, refSheet, refRST)
        Call SAP_ZCS15_MATNR(rstTemp.Fields(0).Value)
        Call SAP_ZCS15_EXCEL
    Else
        Exit Sub
    End If
End Sub

Private Sub EXCEL_IMPORT(ByVal MATNR As String)
'Private Sub EXCEL_IMPORT(ByVal SHEET As Worksheet, ByVal MATNR As String)
Dim lngRow As Long
Dim intCol As Integer
Dim intCnt As Integer

Dim SQL As String
Dim strTemp As String

Dim varArray As Variant

   On Error GoTo EXCEL_IMPORT_Error

    DoCmd.SetWarnings False
    
    varArray = objSheet.Range("A3:M" & objSheet.Range("F65536").End(xlUp).Row).Value 'ASSUMES MAXIMUM ROW COUNT IS 65536
    
    For lngRow = LBound(varArray, 1) To UBound(varArray, 1): DoEvents
        SQL = "INSERT INTO [tbl_Where-Used List] VALUES('" & MATNR & "','"
        For intCol = LBound(varArray, 2) To UBound(varArray, 2)
            strTemp = varArray(lngRow, intCol)
            strTemp = Replace(strTemp, "'", "`")
            strTemp = Replace(strTemp, """", vbNullString)
            
            SQL = SQL & strTemp & "','"
        Next intCol
        
        intCnt = (Len(SQL) - 2)
        SQL = Left(SQL, intCnt) & ");"
        DoCmd.RunSQL SQL
    Next lngRow
    
    DoCmd.SetWarnings True

   On Error GoTo 0
   Exit Sub

EXCEL_IMPORT_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure EXCEL_IMPORT of Module new_dev"
End Sub

Private Sub DB_DELETE_COMPLETED()
Dim SQL As String
    
    DoCmd.SetWarnings False
    SQL = "DELETE * FROM tbl_MATNR AS A " & _
    "WHERE EXISTS (SELECT B.Component FROM [tbl_Where-Used List] AS B WHERE B.Component=A.MATNR);"
    DoCmd.RunSQL SQL
    SQL = "DELETE * FROM tbl_MATNR AS A " & _
    "WHERE EXISTS (SELECT B.MATNR FROM [tbl_Error_Log] AS B WHERE B.SAP_TEXT='No records to download' AND B.MATNR=A.MATNR);"
    DoCmd.RunSQL SQL
    DoCmd.SetWarnings True
End Sub

Private Sub temp_statusbar()
Dim SAPApp As Object
Dim SAPGUI As Object
Dim SAPConnect As Object
Dim SAPSession As Object
Dim WScript As Object
Dim SAPUserArea As Object
    
    If SAPApp Is Nothing Then
        Set SAPGUI = GetObject("SAPGUI")
        Set SAPApp = SAPGUI.GetScriptingEngine
    End If
    If SAPConnect Is Nothing Then
       Set SAPConnect = SAPApp.Children(0)
    End If
    If SAPSession Is Nothing Then
       Set SAPSession = SAPConnect.Children(0)
    End If
    If Not WScript Is Nothing Then
       WScript.ConnectObject SAPSession, "on"
       WScript.ConnectObject SAPApp, "on"
    End If
    
    With SAPSession
        Debug.Print .findById("wnd[0]/sbar").Text
        Debug.Print .findById("wnd[0]/sbar").messageType
    End With
End Sub
